home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / System / Sample Init / Sample without A4 / Sample.p next >
Encoding:
Text File  |  1997-02-01  |  2.3 KB  |  102 lines  |  [TEXT/CWIE]
  1. unit Init;
  2.  
  3. interface
  4.  
  5. {$MAIN}
  6.     procedure Main;
  7.  
  8. implementation
  9.  
  10.     uses
  11.         Traps, Types, Files, Events, OSUtils, Resources, Memory, Processes, GestaltEqu, Traps, SegLoad, LowMem;
  12.  
  13.     type
  14.         ProcPtrPtr = ^ProcPtr;
  15.         
  16.     const
  17.         CurAppNameAddr = $910;
  18.         FinderNameAddr = $2E0;
  19.  
  20.     const
  21.         HelperStateGestalt = 'AsiX';
  22.         HS_Booting = 1;
  23.         HS_Normal = 2;
  24.         
  25.     procedure SpaceForOSDispatchOldAddr;
  26.     begin
  27.     end;
  28.     
  29.     procedure SpaceForInitMenusOldAddr;
  30.     begin
  31.     end;
  32.     
  33.     procedure SpaceForHelperState;
  34.     begin
  35.     end;
  36.  
  37.     function AssimilatorHelperGestalt (selector: OSType; var response: longInt): OSErr;
  38.         var
  39.             SpaceForHelperStatePtr: LongIntPtr;
  40.     begin
  41. {$unused(selector)}
  42.         SpaceForHelperStatePtr := LongIntPtr(@SpaceForHelperState);
  43.         response := SpaceForHelperStatePtr^;
  44.         AssimilatorHelperGestalt := noErr;
  45.     end;
  46.  
  47.     procedure AssimilatorHelperOSDispatchPatch; asm;
  48.     begin
  49.         { check for the PostHighLevelEvent selector }
  50.         cmpi.w    #$34, 4(sp)
  51.         bne.s        continue
  52.         { do stuff }
  53. continue:
  54.         lea        SpaceForOSDispatchOldAddr, a0
  55.         move.l    (a0), a0
  56.         jmp        (a0)
  57.     end;
  58.     
  59.     procedure DoInitMenusPatch;
  60.         var
  61.             SpaceForHelperStatePtr: LongIntPtr;
  62.             SpaceForOSDispatchOldAddrPtr: ProcPtrPtr;
  63.     begin
  64.         SpaceForHelperStatePtr := LongIntPtr(@SpaceForHelperState);
  65.         if (SpaceForHelperStatePtr^ = HS_Booting) & (StringPtr(CurAppNameAddr)^ = StringPtr(FinderNameAddr)^) then begin
  66.             SpaceForHelperStatePtr^ := HS_Normal;
  67.  
  68.             SpaceForOSDispatchOldAddrPtr := ProcPtrPtr(@SpaceForOSDispatchOldAddr);
  69.             SpaceForOSDispatchOldAddrPtr^ := ProcPtr(NGetTrapAddress(_OSDispatch, ToolTrap));
  70.             NSetTrapAddress(@AssimilatorHelperOSDispatchPatch, _OSDispatch, ToolTrap);
  71.         end;
  72.     end;
  73.     
  74.     procedure AssimilatorHelperInitMenusPatch; asm;
  75.     begin
  76.         jsr        DoInitMenusPatch
  77.         lea        SpaceForInitMenusOldAddr, a0
  78.         move.l    (a0), a0
  79.         jmp        (a0)
  80.     end;
  81.     
  82.     procedure Main;
  83.         var
  84.             junk: OSErr;
  85.             SpaceForHelperStatePtr: LongIntPtr;
  86.             SpaceForInitMenusOldAddrPtr: ProcPtrPtr;
  87.     begin
  88.         DetachResource(Get1Resource('INIT', 128));
  89.  
  90.         SpaceForHelperStatePtr := LongIntPtr(@SpaceForHelperState);
  91.         SpaceForInitMenusOldAddrPtr := ProcPtrPtr(@SpaceForInitMenusOldAddr);
  92.         
  93.         SpaceForHelperStatePtr^ := HS_Booting;
  94.         junk := NewGestalt( HelperStateGestalt, @AssimilatorHelperGestalt );
  95.         
  96.         SpaceForInitMenusOldAddrPtr^ := ProcPtr(NGetTrapAddress(_InitMenus, ToolTrap));
  97.         NSetTrapAddress(@AssimilatorHelperInitMenusPatch, _InitMenus, ToolTrap);
  98.  
  99.     end;
  100.  
  101. end.
  102.